RPU 2013 Analyse
date()## [1] "Fri Jan 16 16:21:38 2015"## [1] "Fri Jan 16 15:59:21 2015"source: RPU2013 Ce document exploite le fichier RData préparé à partir de la table *RPU__* de Sagec. Voir le document RPU_2013_Preparation.Rmd du dossier Resural (Resural/Stat Resural/RPU2013/
EN FONCTION DU MOIS MODIFIER LES LIGNES 12, 38, 39, 40 ET 66
Variables globales:
source("../prologue.R")## Loading required package: foreign
## Loading required package: survival
## Loading required package: splines
## Loading required package: MASS
## Loading required package: nnet
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## [1] "Fichier courant: rpu2013d0112.Rda"Activité régionale
wd<-getwd()
# setwd("~/Documents/Resural/Stat Resural/RPU2013/Chapitres/Activite_regionale")
# source(paste(path,"mes_fonctions.R",sep=""))Librairies nécessaires:
load_libraries()Lecture du fichier des données
On lit le fichier de travail créé:
d1<-foo(path)
# if(!exists("d1")) {
# load(paste(path,"rpu2013d0109.Rda",sep=""))
# d1<-d0109
# rm(d0109)
# }Analyse des données
entrées par secteur sanitaire (voir Territoire_Sante.Rmd)
On creé une colonne supplémentaire secteur qui indique à quel secteur sanitaire correspond le RPU:
Nombre de RPU par secteur de santé
tapply(d1$ENTREE,d1$secteur,length)## 1 2 3 4
## 59484 62981 109395 112213Remarques: - secteur 2, manque St Anne, pediatrie HTP, une partie des RPU HUS adulte
entrées totales
# d1<-d1[d1$ENTREE<"2013-10-01",]
e<-as.Date(d1$ENTREE)
q<-tapply(e,yday(e),length)
mean(q) # nb moyen de passages## [1] 945.2555plot(q,type="l")
z<-zoo(q,unique(as.Date(d1$ENTREE)))
plot(z)
plot(xts(z), main="Activité quotidienne des Services d'urgence\nen Alsace",ylab="nombre de passages",minor.ticks=FALSE)
lines(rollmean(xts(z), 7),col="red",lwd=2)
copyright()
z<-zoo(q,unique(as.Date(d1$ENTREE)))
plot(z)
plot(xts(z), main="Activité quotidienne des Services d'urgence\nen Alsace",ylab="nombre de passages",minor.ticks=FALSE)
lines(rollmean(xts(z), 7),col="red",lwd=2)
copyright()
plot(z, col="gray45", main="Activité quotidienne des Services d'urgence\nen Alsace",ylab="nombre de passages",xlab="Année 2013")
lines(rollmean(z, 7),col="red",lwd=2)
abline(h = mean(q), col = "blue")
copyright()
legend("topleft",legend="moyenne lissée",col="red",lty=1,cex=0.8,bty="n")
Variables: - e vecteur contenant les dates d’entrées depuis le début de l’année - q vecteur contenant le nombre d’entrées par jour depuis le début de l’année - q2 vecteur contenant le nombre de retours à domiciles par jour - q3 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux) - q4 vecteur contenant le nombre de retours à domiciles par jour en excluant les non réponses (NA) - q5 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux), en excluant les non réponses (NA) - q6 taux de non réponses - q7 vecteur contenant le taux d’hospitalisation par jour (miroir de q5)
Variables: - e vecteur contenant les dates d’entrées depuis le début de l’année - q vecteur contenant le nombre d’entrées par jour depuis le début de l’année - q2 vecteur contenant le nombre de retours à domiciles par jour - q3 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux) - q4 vecteur contenant le nombre de retours à domiciles par jour en excluant les non réponses (NA) - q5 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux), en excluant les non réponses (NA) - q6 taux de non réponses - q7 vecteur contenant le taux d’hospitalisation par jour (miroir de q5)
Retour à domicile
Les variation du retour journalier à domicile sont calculés de la manière suivante: - numérateur = somme quotidienne où MODE_SOTIE == Domicile - dénominateur = somme quotidienne des ENTREE (correspod à q)
q2<-tapply(d1[d1$MODE_SORTIE=="Domicile",6],yday(d1[d1$MODE_SORTIE == "Domicile", 6]),length)
head(q2)## 1 2 3 4 5 6
## 593 547 449 460 486 511q3<-q2/q
summary(q3)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.5750 0.6243 0.6447 0.6482 0.6680 0.7720plot(q3,type="l")
copyright()
On refait le calcul de q en tenant compte des non réponses:
On refait le calcul de q en tenant compte des non réponses:
q4<-tapply(d1[!is.na(d1$MODE_SORTIE),6],yday(d1[!is.na(d1$MODE_SORTIE), 6]),length)
head(q4)## 1 2 3 4 5 6
## 815 751 633 654 653 654q5<-q2/q4
head(q5)## 1 2 3 4 5 6
## 0.7276074 0.7283622 0.7093207 0.7033639 0.7442573 0.7813456summary(q5)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.6702 0.7298 0.7512 0.7523 0.7725 0.8272plot(q5,type="l",main="Taux de retour à domicile\n(non réponses exclues)",ylab="Fréquence",xlab="Jours")
copyright()
z <- zoo(q5, unique(as.Date(d1$ENTREE)))
plot(z,main="Taux de retour à domicile\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours")
plot(xts(z))
lines(rollmean(xts(z), 7), col = "red",lwd=2)
copyright()
Taux d’hospitalisation ———————- c’est le complément (miroir) du précédent:
z <- zoo(q5, unique(as.Date(d1$ENTREE)))
plot(z,main="Taux de retour à domicile\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours")
plot(xts(z))
lines(rollmean(xts(z), 7), col = "red",lwd=2)
copyright()
Taux d’hospitalisation ———————- c’est le complément (miroir) du précédent:
q7<-1-q2/q4
head(q7)## 1 2 3 4 5 6
## 0.2723926 0.2716378 0.2906793 0.2966361 0.2557427 0.2186544summary(q7)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1728 0.2275 0.2488 0.2477 0.2702 0.3298z <- zoo(q7, unique(as.Date(d1$ENTREE)))
<<<<<<< HEAD
plot(xts(z),main="Taux d'hospitalisation en Alsace à partir des SU\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours")
lines(rollmean(xts(z), 7), col = "blue",lwd=2)
copyright()
Taux de non réponses:
q6<-q4/q
head(q6)## 1 2 3 4 5 6
## 0.8754028 0.8845701 0.8767313 0.8731642 0.8592105 0.8825911summary(q6)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.7925 0.8416 0.8627 0.8616 0.8788 0.9529remarque: la distribution de l’age n’est pas normale
sd <- sd(d1$AGE, na.rm=TRUE)
m <- mean(d1$AGE, na.rm=TRUE)
age <- seq(0,120,1)
hist(d1$AGE, freq = FALSE)
lines(age, dnorm(age,m,sd))
lines(c(m,m), c(0,dnorm(m,m,sd)), col="red")
# si on étudie les majeurs
ma <- mean(d1$AGE[d1$AGE > 17], na.rm=TRUE)
sda <- sd(d1$AGE[d1$AGE > 17], na.rm=TRUE)
hist(d1$AGE[d1$AGE > 17], freq = FALSE)
